﻿ rem -----------------------------------------------------------------------------------------------------------------
 rem -- MUSICAL - Atari 2600 Touch Me! v3 Annual Vintage BASIC Programming Contest for 70 and 80's Micro computers. --
 rem -- v3 is the wild category, includes an AI player (press button) but is now more than 10 lines
 rem -----------------------------------------------------------------------------------------------------------------

 rem ---gameloop subroutine, runs every frame:    ---


 if SWCHB|%11110111=247 then goto editor1

 rem init section: color screen pattern and colored note for each of the 4 programmable Simon/Touch me color tones 
 rem 8 byte sprite arrays (static) and 54 byte array for user programmable simon says pattern: 
 

0 if g=0 then z=0:h=1:for g=0 to 239:virtualworld(g)=255:next g:gosub recolorscreen:rowcolors(9)=100:scrollvirtualworldtoggle=1:p=0 else goto 2

resetgame COLUBK=$0:for i=0 to 51:sim(i)=0:next i:SUSTAINFORFRAMES=10:AUDC0=3:AUDF0=17:AUDV0=31:MUSICINDEX=0 
1 for i=0 to 7:player1(i)=pl(i):next i:NUSIZ1=63:data sim 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 rem end init runs 1x

 rem  variables - f framecounter, p pattern index, t 1/0 toggle
 rem              i frequency value to seed or check for if array element is 0
 rem              r > direction from player, or AI cheats and reads it from an array 
 rem              s > SimonSaysTouchMe AI is active

 
2 if joy0fire=1 and s=0 then s=random(f):return:rem don't require p=0 so AI can take over mid turn if player desires
 if f>30 then f=0:i=0:r=0 else f=f+1:t=1-t:SUSTAINFORFRAMES=SUSTAINFORFRAMES+t:vwpixel(x,y,bindplayer1):goto 9:rem Mr SQL

 if s=0 then goto continue

 rem AI computer opponent:
 COLUBK=0:rem debug yellow
 e=p+1:r=sim(e)
 if r=0 then r=s
 goto 3:rem new item 

 rem end AI computer opponent

continue
 if joy0up=1 then r=29:MUSICINDEX=45:goto 3 
 if joy0right=1 then r=15:MUSICINDEX=135:goto 4
 if joy0down=1 then r=26:MUSICINDEX=90:goto 5
 if joy0left=1 then r=14:MUSICINDEX=180:goto 6

3 if r=29 then SUSTAINFORFRAMES=15:AUDC1=4:AUDF1=29:AUDV1=29:p=p+1:i=29:COLUP1=$ba:x=8:y=1:COLUBK=0:goto7:rem Atari
4 if r=15 then SUSTAINFORFRAMES=15:AUDC1=12:AUDF1=15:AUDV1=18:p=p+1:i=15:COLUP1=67:x=15:y=4:COLUBK=0:goto 7
5 if r=26 then SUSTAINFORFRAMES=15:AUDC0=12:AUDF0=26:AUDV0=15:p=p+1:i=26:COLUP1=$72:x=8:y=8:COLUBK=0:goto 7
6 if r=14 then SUSTAINFORFRAMES=15:AUDC0=4:AUDF0=14:AUDV0=0:p=p+1:i=14:COLUP1=255:x=1:y=4:COLUBK=0:rem Touch Me!
 rem - repeat the pattern if it is finished and build the score bar:
7 if sim(p)=0 and p>0 then sim(p)=i:COLUBK=0:vwpixel(p,9,flip):p=0:s=0:data s2 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 rem - check for error and queue repeat if game is over
8 if sim(p)<>i and i>0 and p>0 then MUSICINDEX=225:COLUP1=0:AUDF1=31:AUDC1=3:AUDV1=20:SUSTAINFORFRAMES=20:p=0:data pl 24,60,60,28,4,5,7,6
 rem check reset:
9 if SWCHB|254<>255 and var1=0 then var1=1:g=0:goto 0:rem reset 
 if SWCHB|254=255 and var1=1 then var1=0

 data random 29,15,26,14,26,14,26,15,29,15,14,15,26,14,26,14,26,15,29,15,29,15,26,14,26,14,26,15,29,15,26,14

 return

skipcontrols bx=MUSICINDEX+9
 gosub loadvar2
test3 if var2=0 then MUSICINDEX=MUSICINDEX+10:gosub recolorscreen:gosub setrowcolors:score=0 else MUSICINDEX=MUSICINDEX+5:score=0
TraceTracker SUSTAINFORFRAMES=0:gosub PlayMusic:rem want next pattern 0 duration setting increments MUSICINDEX by 5
 MUSICINDEX=MUSICINDEX-5
 SUSTAINFORFRAMES=SUSTAINFORFRAMES+1
 w=SUSTAINFORFRAMES:rem 20250220 for AUDV0/AUDV1 volume Fx mirror
 return

colorplayer0
 for i=0 to 3:player0colors(i)=bx:next i:return

recolorscreen
 rem scrollvirtualworldtoggle=1
 for y=0 to 8:x=y*16:x=x+7:x=x+y:rowcolors(y)=x:next y:y=0
 return


algorithmpatt rem one pattern only
 rem create new musical score 
 g=MUSICINDEX+4
 for bx=MUSICINDEX to g
 rem skip control codes
 rem -- not necessary since these algorithms are called from accessible patterns only:
 rem if bx=44 or bx=89 or bx=134 or bx=179 or bx=224 then goto skipnote2
 gosub loadvar2
 rem 20250224 up plus button = algorithm b applied at pattern level
 if m=2 then var2=var2&%00011111:var2=var2+5 else var2=var2&%00001111:var2=var2+3 
 gosub setvar2
 rem MusicData(var2)=var2^%00001111+5:rem 3
skipnote2 
 next bx
 g=0 
 return

algorithm2
 rem create new musical score 
 for bx=0 to 249
 rem skip control codes
 if bx=44 or bx=89 or bx=134 or bx=179 or bx=224 then goto skipnote3
 gosub loadvar2
 var2=var2&%00001111
 var2=var2+3
 gosub setvar2
 rem MusicData(bx)=var2&%00011111+3:rem 3
skipnote3 
 next bx
 return


 data fastm 0,8,16,24,32,40,48,56,64,72,80,88,96,104,112,120,128,136,144,152,160,168,176,184,192,200,208,216,224,232,240,248


editor1

callalgorithms 
 rem all chiptunes
 if var1=0 and SWCHB|254<>255 then var1=1:gosub algorithm2:gosub TraceTracker
 rem 2025024 2nd method to call algorithm2: hold left and press button:
 if var1=1 and joy0left=1 and joy0fire=1 and m=0 then m=1:gosub algorithm2:gosubTraceTracker


 rem pattern level
 if var1=0 and SWCHB|%11111101<>255 then var1=1:gosub algorithmpatt:gosub TraceTracker:rem select
 rem 2025024 2nd method to call algorithmpatt: hold right and press button:
 if var1=1 and joy0right=1 and joy0fire=1 and m=0 then m=1:gosub algorithmpatt:gosubTraceTracker
 if var1=1 and joy0up=1 and joy0fire=1 and m=0 then m=2:gosub algorithmpatt:gosubTraceTracker

checktokens
 rem next token? 
 if var1=0 and joy0right=1 and score<4 then score=score+1:var1=1
 rem prior token?
 if var1=0 and joy0left=1 and score>0 then score=score-1:var1=1

 COLUBK=0

 rem clear joystick input when stick is centered: (incldue reset, clear when reset is not set)
 if SWCHB|%11111101=255 and SWCHB|254=255 and joy0right=0 and joy0up=0 and joy0down=0 and joy0left=0 and var1=1 then var1=0:rem same input scheme to move joystick incrementally

 rem advance to next pattern?
 if m=0 and joy0fire=1 and MUSICINDEX<245 then m=1:y=y+1:gosub setrowcolors:gosub skipcontrols:return 

 rem gosub checktokens  -- done in top vertical blank

 if var1=0 and joy0up=1 then var1=1:t=1:gosub txpattern
 
 if var1=0 and joy0down=1 then var1=1:t=0:gosub txpattern

 rem --- music editor top vertical blank code ---
 return

 rem ------------------------------------------------
 rem ---gameloop2 subroutine, runs every frame:   ---
 rem ------------------------------------------------
 
 rem --- Tracker Editor chiptune index

 rem --- 0   - main tune
 rem --- 45  - subtune when UP is selected
 rem --- 90  - subtune when DOWN is selected
 rem --- 135 - subtune when LEFT is selected
 rem --- 180 - subtune when RIGHT is selected
 rem --- 225 - subtune when losing a round

 rem --- Tracker editor variable map-----------------
 rem --- f - frames, z - draw grid flag, var1 - joystick released
 rem --- score - hilight cursor, var2 used by tracker editor
 rem --- z - on/off tracker GUI, y tilepixel virtualworld coordinate
 rem --- bx index of MusicData chiptunes
 rem 20250220 improving Editor to mirror waxing and waning of voice one and voice 2 Fx and variable sustain lengths
 rem --- w - SUSTAINFORFRAMES Fx mirror, var1, m - control toggle

 rem --- activate editor if BW switch is thrown
 if SWCHB|%11110111<>247 then var2=0:return
 rem setup editor grid: setup TPL Tracker Player list program to return 1st pattern: 
 if z=0 then NUSIZ1=0:for y=0 to 8:for x=0 to 20 step 4:vwpixel(x,y,flip):next x,y:x=0:y=9:gosub setrowcolors:y=0:gosub setrowcolors:MUSICINDEX=0:gosub TraceTracker:z=1:g=0:score=0

 SUSTAINFORFRAMES=SUSTAINFORFRAMES+1

 rem apply shaped volume Fx to voices:
 if w>0 then w=w-1 else SUSTAINFORFRAMES=2:rem ?
 AUDV0=w:AUDV1=w

 if f>2 then f=0 else f=f+1:rem frame

 if f>0 then goto notframe0
 if score=1 then COLUP1=60 else COLUP1=255
 if score=0 then bx=60 else bx=255
 gosub colorplayer0
 
 rem --- instrument v1
 bx=MUSICINDEX:gosub loadvar2
 var2=fastm(var2):rem var2*8
 loadplayer0(var2)
 vwpixel(2,y,bindplayer0)
 rem --- v1 note
 bx=MUSICINDEX+1:gosub loadvar2
 var2=fastm(var2):rem var2*8
 loadplayer1(var2)
 vwpixel(6,y,bindplayer1)
 goto doneframes
   
notframe0 rem ---- 
 if score=3 then COLUP1=60 else COLUP1=255
 if score=2 then bx=60 else bx=255
 gosub colorplayer0

 if f>1 then goto notframe1
 rem --- instrument v2
 bx=MUSICINDEX+2:gosub loadvar2
 var2=fastm(var2):rem var2*8
 loadplayer0(var2)
 vwpixel(11,y,bindplayer0)
 rem --- v2 note
 bx=MUSICINDEX+3:gosub loadvar2
 var2=fastm(var2):rem var2*8
 loadplayer1(var2)
 vwpixel(14,y,bindplayer1)
 goto doneframes

notframe1 rem duration ---
 rem color both digits for duration (up to 99):
 if score=4 then COLUP1=60:bx=60 else COLUP1=255:bx=255
 rem gosub colorplayer0
 rem --- first digit
 bx=MUSICINDEX+4:gosub loadvar2
 j=var2/10:i=b
 j=fastm(j):rem j*8
 loadplayer0(j)
 vwpixel(17,y,bindplayer0)
 rem --- duration second digit (up to 99)
 i=i*8
 loadplayer1(i)
 vwpixel(18,y,bindplayer1)

doneframes


 if m<>0 and joy0fire=0 then m=0:rem clear

 rem --- music editor bottom vertical blank code ---
   
 return

loadvar2
 var2=MusicData(bx)
 return

setvar2
 MusicData(bx)=var2
 return

setrowcolors
 rowcolors(y)=0
 scrollvirtualworldtoggle=1
 return

txpattern
 bx=MUSICINDEX+score
 i=MusicData(bx)
 if t=1 then i=i+1 else i=i-1
 if t=0 and i=255 then return:rem below zero
 if i=0 and score=4 then return:rem duration must be at least one frame (zero duration indicate4s control frames used to bind subtunes and Fx to game events)
 MusicData(bx)=i
 gosub TraceTracker
 return

virtualworld
..................xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx....xxxxx....xxxxxxxx
..................xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.xx.xxxxx.....xxxxxxxx
.........xxx......xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx....xxxxxxxxxxxxxxxx....xxxxx....x.xxxxxxxx
.........xxx.xxxx.xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.xx.xxxxxxxxxxxxxxx.xx.xxxxx....xx.xxxxxxxx
.........xxx.xxxx.xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx....xxxxxxxxxxxxxx.x..xxxxx....xxx.xxxxxxxx
.........xxx......xxxxxxxxxxxx.....xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx....xxxxx....xxxx.xxxxxxxx
.........xxxxxxxxxxxxxxxxxxxx........xxxxxxxxxxxxxxxxxxxxxxxxxxxxx....xxxxx...xxxxx.xxxxxxxx
.........xxxxxxxxxxxxxxxxxxx...........xxxxxxxxxxx.xxxxxxxxxxxxxxx....xxxxx...xxxxx.xxxxxxxx
xx.xxxx......xxxxx..xxxxxxx.............xxxxxxxxx...xxxxxxxxxxxxxx....xxxxx...xxxxx.xxxxxxxx
xx...xxxx....xx.....xxxxxxxx..........xxxxxxxxxx.....xxxxxxxxxxxxx....xxxxx...xxxxx.xxxxxxxx
xx...xxxxxxxxxx..xxxxxxxxxxxx........xxxxxxxxxx.......xxxxxxxxxxxx....xxxxx...xxxx.xxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx......xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx....xxxxx...xxx.xxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx....xxxxx...xx.xxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx..xxxxxxxx.xx....xxxxx....xxxxxxxxxxxxx
.......xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx...xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
.xx.xx.xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx....xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
.......xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.....xxxxxxxxxxxxxxxxxxxxxxxxxxxx.xxxxx
.xx.xx.xxxxxxxxxxxxxx..........xxxxxxxxxxxxxxxxxxxxxx......xxxxxxxxxxxxxxxxxxxxxxxxxx...xxxx
x......xxxxxxxxxxxxxx..........xxxxxxxxxxxxxxxxxxxxxx.......xxxxxxxxxxxxxxxxxxxxxxxx.xxx.xxx
xxxxxxxxxxxxxxxxxxxxx..........xxxxxxxxxxxxxxxxxxxxxx........xxxxxxxxxxxxxxxxxxxxxxxx...xxxx

sprites
........
.....xx.
....x..x
....x..x
....x..x
....x.xx
.....xx.
........

........
.....xx.
....xxx.
.....xx.
.....xx.
.....xx.
.....xx.
........

........
....xxx.
....x..x
.......x
......x.
.....xx.
....xxxx
........

........
....xxx.
.......x
.......x
....xxxx
.......x
....xxx.
........

........
.......x
......xx
.....x.x
....xxxx
......xx
......xx
........

........
....xxxx
....x...
....xxxx
.......x
.......x
....xxxx
........

........
.....xx.
....x..x
....x...
....xxx.
....x..x
....xxx.
........

........
....xxxx
......xx
.....xx.
....xx..
....xx..
....xx..
........

........
.....xx.
....x..x
....x..x
.....xx.
....x..x
.....xx.
........

........
.....xx.
....x..x
....x..x
.....xxx
.......x
.......x
........

........
.xx..xx.
xxx.x..x
.xx.x..x
.xx.x..x
.xx.x.xx
.xx..xx.
........

........
.xx..xx.
xxx.xxx.
.xx..xx.
.xx..xx.
.xx..xx.
.xx..xx.
........

........
.xx.xxx.
xxx.x..x
.xx....x
.xx...x.
.xx..xx.
.xx.xxxx
........

........
.xx.xxx.
xxx....x
.xx....x
.xx.xxxx
.xx....x
.xx.xxx.
........

........
.xx....x
xxx...xx
.xx..x.x
.xx.xxxx
.xx...xx
.xx...xx
........

........
.xx.xxxx
xxx.x...
.xx.xxxx
.xx....x
.xx....x
.xx.xxxx
........

........
.xx..xx.
xxx.xx.x
.xx.xx..
.xx.xxx.
.xx.x..x
.xx.xxx.
........

........
.xx.xxxx
xxx...xx
.xx..xx.
.xx.xx..
.xx.xx..
.xx.xx..
........

........
.xx..xx.
xxx.x..x
.xx.x..x
.xx..xx.
.xx.x..x
.xx..xx.
........

........
.xx..xx.
xxx.x..x
.xx.x..x
.xx..xxx
.xx....x
.xx....x
........

........
xxx..xx.
x.x.x..x
..x.x..x
.x..x..x
x...x.xx
xxx..xx.
........

........
xxx..xx.
x.x.xxx.
..x..xx.
.x...xx.
x....xx.
xxx..xx.
........

........
xxx.xxx.
x.x.x.x.
..x...x.
.x...x..
x...x...
xxx.xxx.
........

........
xxx.xxx.
x.x....x
..x....x
.x..xxxx
x......x
xxx.xxx.
........

........
xxx....x
x.x...xx
..x..x.x
.x..xxxx
x.....xx
xxx...xx
........

........
xxx.xxxx
x.x.x...
..x.xxxx
.x.....x
x......x
xxx.xxxx
........

........
xxx..xx.
x.x.x..x
..x.x...
.x..xxx.
x...x..x
xxx.xxx.
........

........
xxx.xxxx
x.x...xx
..x..xx.
.x..xx..
x...xx..
xxx.xx..
........

........
xxx..xx.
x.x.x..x
..x.x..x
.x...xx.
x...x..x
xxx..xx.
........

........
xxx..xx.
x.x.x..x
..x.x..x
.x...xxx
x......x
xxx....x
........

........
xx...xx.
..x.x..x
..x.x..x
xxx.x..x
..x.x.xx
xx...xx.
........

........
xx...xx.
..x.xxx.
..x..xx.
xxx..xx.
..x..xx.
xx...xx.
........

player0colors 5,4,4,4,15,15,15,15

chiptunes
7,14,4,16,10
12,6,11,17,10
1,7,1,3,1
2,2,3,4,33
0,0,0,0,33
7,1,7,31,2
0,0,0,0,33
6,31,4,31,2
0,0,0,0,0
45
1,15,1,7,5
1,13,1,7,5
1,15,1,31,2
1,15,1,31,2
1,15,1,31,2
0,0,0,0,4
1,13,1,7,5
1,15,1,31,2
0,0,0,0,0
90
1,15,1,7,7
1,13,1,7,15
1,15,1,31,7
1,15,1,31,12
1,15,1,31,6
0,0,0,0,12
1,15,1,7,15
1,13,1,7,7
1,15,1,31,0
135
1,15,1,31,2
0,0,0,0,4
1,29,1,19,10
1,31,1,23,2
1,29,1,19,2
1,31,1,23,2
0,0,0,0,4
1,29,1,19,10
0,0,0,0,0
180
1,31,1,31,5
1,31,1,23,5
1,29,1,19,5
1,31,1,23,5
8,24,8,20,8
10,24,10,20,8
8,24,8,20,4
12,9,12,7,4
0,0,0,0,0
225
10,24,10,20,12
8,24,8,20,12
10,24,10,20,22
8,24,8,20,22
10,24,10,20,12
0,0,0,0,0

111111111100000000001111111111000000000011111111110000000000111111111100000000001111111111000000000011111111110000000000




